package histogram;

require Exporter;

sub get_moving_avg_histogram(\@$$$$\@\@\@\@);

our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(   get_moving_avg_histogram get_moving_avg_percent_histogram);

use strict;
use warnings;



#return the first element not less than $val.
sub lower_bound($$$$)
{

	my($array, $first, $last, $val) = @_;

	my $len = $last - $first;
	my ($half, $middle);

	while ( $len > 0 )
	{
		$half = $len >> 1;
		$middle = $first;
		$middle += $half;
		if ( $array->[$middle] < $val )
		{
			$first = $middle + 1;
			$len = $len - $half - 1;
		}
		else
		{
			$len = $half;
		}
	}
	return $first;
}
#return the first element greater than $val.
sub upper_bound($$$$)
{

	my($array, $first, $last, $val) = @_;

	my $len = $last - $first;
	my ($half, $middle);

	while ( $len > 0 )
	{
		$half = $len >> 1;
		$middle = $first;
		$middle += $half;
		if ( $array->[$middle] > $val )
		{
			$len = $half;
		}
		else
		{
			$first = $middle + 1;
			$len = $len - $half - 1;
		}
	}
	return $first;
}

#_________________________________________________________________________________________

#	get_moving_avg_histogram

#	input:

#	\@		array of values
#	$		minimum value
#	$		maximum value
#	$		bin size
#	$		number of subdivisions
#	\@		array of smooth bins/sizes
#	\@		array of bins/sizes

#	returns:

#	$		array of bins/sizes
#_________________________________________________________________________________________
sub float_lt($$)
{
	return ($_[1] >  $_[0]) || (abs($_[1] - $_[0]) < ($_[1] * 0.0001));
}
sub get_moving_avg_histogram(\@$$$$\@\@\@\@)
{
	my ($values, $mini, $maxi, $bin_sz, $cnt_sub_bins, $smooth_resultsx, $smooth_resultsy, $resultsx, $resultsy) = @_;

	#don't assume values sorted
	@$values = sort  {$a <=> $b} @$values;
	$cnt_sub_bins = int($cnt_sub_bins);

	my $cnt_values = @$values;
	my $bin_beg = $mini;
	my $bin_half = ($bin_sz) / 2.0;
	my $lower = 0;
	my $upper = 0;
	my $cnt_bins = 0;

	while (float_lt($bin_beg + $bin_sz, $maxi))
	{
		$lower = lower_bound($values, $lower, $cnt_values, $bin_beg);
		my $cnt_values_in_bin = 0;
		if ($lower != $cnt_values)
		{
			$upper = $lower if ($upper < $lower);
			$upper = upper_bound($values, $upper, $cnt_values, $bin_beg + $bin_sz);
			$cnt_values_in_bin = $upper - $lower;
		}

		
		if ($cnt_bins % $cnt_sub_bins == 0)
		{
			push(@$resultsx, $bin_beg + $bin_half);
			push(@$resultsy, $cnt_values_in_bin);
		}
		push(@$smooth_resultsx, $bin_beg + $bin_half);
		push(@$smooth_resultsy, $cnt_values_in_bin);
		++$cnt_bins;
		$bin_beg = $mini + $bin_sz * $cnt_bins / $cnt_sub_bins;
	}
	return;
}
sub get_moving_avg_percent_histogram(\@$$$$\@\@\@\@)
{
	my ($values, $mini, $maxi, $bin_sz, $cnt_sub_bins, $smooth_resultsx, $smooth_resultsy, $resultsx, $resultsy) = @_;

	#don't assume values sorted
	@$values = sort  {$a <=> $b} @$values;
	$cnt_sub_bins = int($cnt_sub_bins);
	my $total_cnt = @$values;

	my $cnt_values = @$values;
	my $bin_beg = $mini;
	my $bin_half = ($bin_sz) / 2.0;
	my $lower = 0;
	my $upper = 0;
	my $cnt_bins = 0;

	while (float_lt($bin_beg + $bin_sz, $maxi))
	{
		$lower = lower_bound($values, $lower, $cnt_values, $bin_beg);
		my $cnt_values_in_bin = 0;
		if ($lower != $cnt_values)
		{
			$upper = $lower if ($upper < $lower);
			$upper = upper_bound($values, $upper, $cnt_values, $bin_beg + $bin_sz);
			$cnt_values_in_bin = ($upper - $lower) / $total_cnt;
		}

		
		if ($cnt_bins % $cnt_sub_bins == 0)
		{
			push(@$resultsx, $bin_beg + $bin_half);
			push(@$resultsy, $cnt_values_in_bin);
		}
		push(@$smooth_resultsx, $bin_beg + $bin_half);
		push(@$smooth_resultsy, $cnt_values_in_bin);
		++$cnt_bins;
		$bin_beg = $mini + $bin_sz * $cnt_bins / $cnt_sub_bins;
	}
	return;
}
1;


